BBS in a Box 7/BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso/Files/Tele/T/The Survey Editor2.0.HC.cpt/The Survey Editor 2.0/stack.txt

Text File | 1990-01-30 | 17KB | 487 lines

-- stack: in.0
-- format: 8 (HyperCard 1)
-- flags: 0x1000 (none)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=0, y1=0, x2=0, y2=0)
-- screen: Rect(x1=0, y1=0, x2=0, y2=0)
-- card dimensions: w=0 h=0
-- scroll: x=0 y=0
-- background count: 1
-- first background id: 2767
-- card count: 4
-- first card id: 2955
-- list block id: 3733
-- print block id: 0
-- font table block id: 0
-- style table block id: 0
-- free block count: 0
-- free size: 0 bytes
-- total size: 62944 bytes
-- stack block size: 15872 bytes
-- created by hypercard version: 0x01228000
-- compacted by hypercard version: 0x01228000
-- modified by hypercard version: 0x01228000
-- opened by hypercard version: 0x01228000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x8000000008000000
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0x8888222288882222
-- patterns[4]: 0x88AA22AA88AA22AA
-- patterns[5]: 0xCCAA33AACCAA33AA
-- patterns[6]: 0xEEAABBAAEEAABBAA
-- patterns[7]: 0xEEBBBBEEEEBBBBEE
-- patterns[8]: 0xFFBBFFEEFFBBFFEE
-- patterns[9]: 0xFFBBFFFFFFBBFFFF
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xC4800C6843023026
-- patterns[15]: 0xB130031BD8C00C8D
-- patterns[16]: 0xAA00AA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0x0
----- HyperTalk script -----
on openStack
  set cursor to watch
  if the version < 1.2 then
    answer "Sorry, I need HyperCard 1.2 or greater."
    set lockMessages to true
    go home
    exit openStack
  end if
  hide menuBar
  global User_level
  put the userlevel into User_level
  set the userlevel to 5
  global commandLIST
  put cd field "commandLIST" into commandLIST

  put "About...,(-,New,Open.../A,(-,Save,Save As.../W,Revert,(-,Print...," & "Print Code...,(-,Show All Code/G,Show Code of a Line..." into EditorMenu
  put "Add,Insert,Replace,Edit,Delete,(-,Label Above Command" into CommandsMenu
  put "Bell,Tab,Clear Screen,Backspace,(-,Other..." into CtrlMENU

  menuHandler "add","Editor",EditorMenu
  menuHandler "add","Commands",CommandsMenu
  menuHandler "add","Insert Control...",CtrlMENU
  menuHandler "hide","Insert Control...",CtrlMENU

  if the hilite of cd btn "label above command" is true then
    repeat with x = 2 to 5
      menuHandler "disable","commands",x
    end repeat
    menuHandler "disable","Editor",13
    menuHandler "mark","commands","Label Above Command","check"
  end if
end openStack

on CloseStack
  lock screen
  set cursor to watch
  go cd 1
  if cd field id 99 ≠ ""
  then set the hilite of cd btn id (item 1 of cd field id 99) to false
  put "" into cd field id 99
  menuHandler "delete","Editor"
  menuHandler "delete","Commands"
  menuHandler "delete","Insert Control..."
  if the freesize of this stack > 25000 then domenu "compact stack"
  global User_level
  set the userlevel to User_level
  show menubar
end CloseStack

Function lineClicked
return (trunc(((scroll of the target) + (item two of the clickloc) - (item two of the rect of the target)) div the textheight of the target) + one)
end lineClicked

function realName fichier
put "" into applName
repeat with x = the number of chars in fichier down to 1
  if char x of fichier = ":" then
    exit repeat
  else
    put char x of fichier before applName
  end if
end repeat
return applName
end realname

Function theLineClicked clickLic
return (trunc(((scroll of cd field "survey") + (item two of clickLic) - (item two of the rect of cd field "survey")) div the textheight of cd field "survey") + one)
end theLineClicked

function compute name,tType,text,length,branch
global commandLIST
put "" into displayString

put "0,5,6,8,18,37,38,43,44,45,46" into exceptions
repeat with x = 1 to 11
  if tType = item x of exceptions then
    put line (tType+1) of commandLIST into displayString
    if name ≠ "" then
      put "  •" && name && "•" after displayString
    end if
    return displayString
    exit compute
  end if
end repeat

if tType = 1 then
  if length = 0 then
    put "Display “" & text & "” with a CR"  after displayString
  else
    put "Display “" & text & "” with no CR"  after displayString
  end if
end if
if tType = 2 then
  put "Branch immediately to “" & branch & "”" into displayString
end if
if tType = 3 then
  put "If last input contains “" & text & "”, branch to “" & branch & "”" into displayString
end if
if tType = 4 then
  put "If last input was empty, branch to “" & branch & "”" into displayString
end if
if tType = 7 then
  put "Stop execution of the Survey file and return to the last " & "Red Ryder Host menu." into displayString
end if
if tType = 9 then
  put "Get input [" & length & "] from the user." into displayString
  if text ≠ "" then
    put "Display “" & text & "” and " before displayString
  end if
end if
if tType = 10 then
  put "Get 'Y' or 'N' from the user." into displayString
  if text ≠ "" then
    put "Display “" & text & "” and " before displayString
  end if
end if
if tType = 11 then
  put "Get a CR from the user." into displayString
  if text ≠ "" then
    put "Display “" & text & "” and " before displayString
  end if
end if
if tType = 12 then
  put "Display “" & text & "” with CR to the scratch file." into displayString
end if
if tType = 13 then
  put "Display “" & text & "” with no CR to the scratch file." into displayString
end if
if tType = 14 then
  put "Raise current caller's time limit for this call only to " & length into displayString
end if
if tType = 15 then
  put "Raise current caller's time limit permanently to " & length into displayString
end if
if tType = 16 then
  put "Set the caller's clearance level for this for this call only to " & length into displayString
end if
if tType = 17 then
  put "Set the caller's clearance level permanently to " & length into displayString
end if
if tType = 19 then
  put "Write the value of ASCII character “" & text & "” to the response file." into displayString
end if
if tType = 20 then
  put "Clear out the scratch file and branch to “" & branch & "”" into displayString
end if
if tType = 21 then
  put "If the user's down/upload ratio is less than " & text & ", then branch to “" & branch & "”" into displayString
end if
if tType = 22 then
  put "Temporarily sets the current caller's restriction flag " & "number " & text into displayString
end if
if tType = 23 then
  put "Permanently sets the current caller's restriction flag " & "number " & text into displayString
end if
if tType = 24 then
  put "Temporarily resets the current caller's restriction flag " & "number " & text into displayString
end if
if tType = 25 then
  put "Permanently resets the current caller's restriction flag " & "number " & text into displayString
end if
if tType = 26 or tType = 27 or tType = 28 or tType = 29 then
  put "Display TEXT file “" & realName(text) into displayString
  if tType = 26 then put "” (Cancellable, no prompts)" after displayString
  if tType = 27 then put "” (Cancellable, all prompts)" after displayString
  if tType = 28 then put "” (Not cancellable, all prompts)" after displayString
  if tType = 29 then put "” (Cancellable, only final prompts)" after displayString
end if
if tType = 30 then
  put "Create a Special Scratch File and allocate " & text & " accumulators."into displayString
end if
if tType = 31 then
  put "Add " & item 1 of text & " to the Special Scratch File " & "accumulator " & item 2 of text into displayString
end if
if tType = 32 then
  put "Add the contents of Special Scratch accumulator " & item 1 of text & " to the Special Scratch File " & "accumulator " & item 2 of text into displayString
end if
if tType = 33 then
  put "Display the string equivalent of the Special Scratch file " & "accumulator " & text & " with a CR." into displayString
end if
if tType = 34 then
  put "Display the string equivalent of the .CNT file " & "accumulator " & text & " with a CR." into displayString
end if
if tType = 35 then
  put "Display the string equivalent of the Special Scratch file " & "accumulator " & text & " with no CR." into displayString
end if
if tType = 36 then
  put "Display the string equivalent of the .CNT file " & "accumulator " & text & " with no CR." into displayString
end if
if tType = 39 then
  put "If current caller's name appears in .CNT file, execute " & "the survey: “" & realName(branch) & "”." into displayString
end if
if tType = 40 then
  put "Put " & item 2 of text & " into the Special " & "Scratch accumulator " & item 1 of text into displayString
end if
if tType = 41 then
  put "Display the percentage that .CNT file accumulator " & item 1 of text & " is of .CNT file acc. " & item 2 of text & " with a CR." into displayString
end if
if tType = 42 then
  put "Display the percentage that .CNT file accumulator " & item 1 of text & " is of .CNT file acc. " & item 2 of text & " with no CR." into displayString
end if
if name ≠ "" then
  put "  •" && name && "•" after displayString
end if
return displayString
end compute

on command commandNumber,displayString
  put return into r
  lock screen
  if commandNumber = 0 then
    put "" & r & "" & r & "0" & r & "" & r & "" & r & "" into command
    WRTstrg command,displayString, line 1 of cd field "action",line 2 of cd field "action"
    exit command
  end if

  if commandNumber = 1 then
    go cd "input"
    initiate true,"Label:",false,"",false,"",true, "Text to display...",true,false,1,displayString
    exit command
  end if

  if commandNumber = 2 then
    go cd "input"
    initiate false,"",false,"",true,"Branch to:",false, "",false,false,2,displayString
    exit command
  end if

  if commandNumber = 3 then
    go cd "input"
    initiate true,"Label:",false,"",true, "Branch to:",true,"Text to verify...",false,false,3,displayString
    exit command
  end if

  if commandNumber = 4 then
    go cd "input"
    initiate false,"",false,"",true, "Branch to:",false,"",false,false,4,displayString
    exit command
  end if

  if commandNumber = 5 or commandNumber = 6 then
    put "" & r & "" & r & commandNumber & r & "" & r & "" & r & "" into command
    WRTstrg command,displayString, line 1 of cd field "action",line 2 of cd field "action"
    exit command
  end if

  if commandNumber = 7 then
    go cd "input"
    initiate true,"Label:",false,"",false, "",false,"",false,false,7,displayString
    exit command
  end if

  if commandNumber = 8 then
    put "" & r & "" & r & "8" & r & "" & r & "" & r & "" into command
    WRTstrg command,displayString, line 1 of cd field "action",line 2 of cd field "action"
    exit command
  end if

  if commandNumber = 9 then
    go cd "input"
    initiate true,"Label:",true,"Length Maximum:",false,"",true, "Display this text (empty if nothing)...",false,false,9,displayString
    exit command
  end if

  if commandNumber = 10 then
    go cd "input"
    initiate true,"Label:",true,"Length:",false, "",true,"Display this text (empty if nothing)..." ,false,false,10,displayString
    put "1" into cd field "length"
    exit command
  end if

  if commandNumber = 11 then
    go cd "input"
    initiate true,"Label:",false,"",false, "",true,"Display this text (empty if nothing)..." ,false,false,11,displayString
    put "1" into cd field "length"
    exit command
  end if

  if commandNumber = 12 then
    go cd "input"
    initiate true,"Label:",false,"",false, "",true,"Text to display...",false,false,12,displayString
    put "1" into cd field "length"
    exit command
  end if

  if commandNumber = 13 then
    go cd "input"
    initiate true,"Label:",false,"",false, "",true,"Text to display...",false,false,13,displayString
    put "1" into cd field "length"
    exit command
  end if

  if commandNumber = 14 or commandNumber = 15 then
    go cd "input"
    initiate true,"Label:",true,"New Time Limit:",false, "",false,"",false,false,commandNumber,displayString
    put "1" into cd field "length"
    exit command
  end if

  if commandNumber = 16 or commandNumber = 17 then
    go cd "input"
    initiate true,"Label:",true,"New Level:",false, "",false,"",false,false,commandNumber,displayString
    put "1" into cd field "length"
    exit command
  end if

  if commandNumber = 18 then
    put fileName("MENU","Select the menu to return to...") into text
    if text is empty then exit command
    put "Stop the survey and return to RRH menu “" & text & "”" into displayString
    put "" & r & "" & r & "18" & r & text & r & "" & r & "" into command
    WRTstrg command,displayString, line 1 of cd field "action",line 2 of cd field "action"
    exit command
  end if

  if commandNumber = 19 then
    go cd "input"
    initiate true,"Label:",false,"",false,"",true, "ASCII character to write...",false,false,19,displayString
    exit command
  end if

  if commandNumber = 20 then
    go cd "input"
    initiate false,"",false,"",true, "Clear out the scratch file and branch to:",false, "",false,false,20,displayString
    exit command
  end if

  if commandNumber = 21 then
    go cd "input"
    initiate true,"Label:",false,"",true,"Branch:",true, "User's download to upload ratio...",false,false,21,displayString
    exit command
  end if

  if commandNumber = 22 or commandNumber = 23 then
    go cd "input"
    initiate true,"Label:",false,"",false, "",true," Set restriction flag number...", false,false,commandNumber,displayString
    exit command
  end if

  if commandNumber = 24 or commandNumber = 25 then
    go cd "input"
    initiate true,"Label:",false,"",false, "",true,"Reset restriction flag number...", false,false,commandNumber,displayString
    exit command
  end if

  if commandNumber = 26 or commandNumber = 27 or commandNumber = 28 or commandNumber = 29 then
    go cd "input"
    initiate true,"Label:",false,"",false, "",true,"Text file to display:", false,true,commandNumber,displayString
    exit command
  end if

  if commandNumber = 30 then
    go cd "input"
    initiate false,"",false,"",false,"",true, "Number of Accumulators to allocate:",false,false,30,displayString
    exit command
  end if

  if commandNumber = 31 then
    go cd "input"
    initiate false,"",false,"",false,"",true, "Number to add, Accumulator y (separated by a comma)...",false,false,31,displayString
    exit command
  end if

  if commandNumber = 32 then
    go cd "input"
    initiate false,"",false,"",false,"",true, "Accumulator x, Accumulator y (separated by a comma)...", false,false,32,displayString
    exit command
  end if

  if commandNumber = 33 or commandNumber = 35 then
    go cd "input"
    initiate false,"",false,"",false, "",true,"Special Scratch file accumulator number...", false,false,commandNumber,displayString
    exit command
  end if

  if commandNumber = 34 or commandNumber = 36 then
    go cd "input"
    initiate false,"",false,"",false, "",true,".CNT file accumulator number...", false,false,commandNumber,displayString
    exit command
  end if

  if commandNumber = 37 or commandNumber = 38 then
    put "" & r & "" & r & commandNumber & r & "" & r & "" & r & "" into command
    WRTstrg command,displayString, line 1 of cd field "action",line 2 of cd field "action"
    exit command
  end if

  if commandNumber = 39 then
    go cd "input"
    initiate false,"",false,"",true,"Survey file to branch to: ",false,"",false,true,39,displayString
    exit command
  end if

  if commandNumber = 40 then
    go cd "input"
    initiate false,"",false,"",false,"",true, "Acc. y to set, Number x (separated by a comma)...",false,false,40,displayString
    exit command
  end if

  if commandNumber = 41 or commandNumber = 42 then
    go cd "input"
    initiate false,"",false,"",false, "",true,"Accumulator x, Accumulator y (separated by a comma)...", false,false,commandNumber,displayString
    exit command
  end if

  if commandNumber = 43 or commandNumber = 44 or commandNumber = 45 or commandNumber = 46 then
    put "" & r & "" & r & commandNumber & r & "" & r & "" & r & "" into command
    WRTstrg command,displayString, line 1 of cd field "action",line 2 of cd field "action"
    exit command
  end if
end command

on WRTstrg a,b,c,d
  lock screen
  set lockMessages to true
  writeString a,b,c,d
end WRTstrg